Attribute VB_Name = "modODBCCopernicus"
'---------------------------------------------------------------------------------------
'Module     : modODBC
'Date       : 05/18/2004
'Updated    : 02/21/2005
'Author     : Chris Elwell
'Purpose    : This is an example of a CIC integration module. This is for demostration
'           purposes only. You must write the code required to get/writeback data from/to
'           your customer's data source.
'
'           This example uses the FSMSClientTest.mdb. A DSN is setup as FSMSClientTest.
'           Regardless of the integration method, CICs must have a module that contains
'           specific sub routines. All of these subs/functions listed below must exist
'           as they are called from the main program.
'           Public Function GetData(ByVal strKey As String) As Boolean - this routine is
'               called when the Order ID field loses focus. This is where you would code to
'               get order data from a customer and populate the screen fields. You can create
'               and call as many support routines as necessary. Also, this routine should
'               return a boolean True if getting the order data was succesful and a boolean
'               False if it was not.
'           Public Sub WriteReply() - this is called after a successful shipment. A typical
'               use would be to write FXRS reply data back to a customer's system, but can be
'               used for anything that you want to have happen after a pckage is shipped.
'           Public Sub WriteError() - this is called after an error is returned from FXRS.
'           Public Sub WriteDelete(ByVal strTracking As String) - this is called after a
'               package is successfully deleted.
'           Public Sub AfterClose() - this is called after FXRS is closed.
'           Public Sub BeforeClose() - this is called just before an FXRS close transaction
'               is sent.
'Updated:   Public Function BeforeShip() - Return TRUE to continue shipment, False to cancel.
'           Public Sub Initialize() - this is called once on program execution.
'           Public Sub BeforeBatch() - this is called before processing a batch file.
'           Public Sub BeforeBatchShip() - this is called before each individual batch transaction.
'New:       Public Sub AfterAddrLookup() - this is called after cboCustID, cboContact, and cboCompany lose focus
'New:       Public Sub AfterDeptLostFocus() - this is called after cboDept or f38 loses focus.
'
' 2005-04-20, JFW, Added AddDSN for integration database.
' 2006-11-07, JFW, Add order to MPS select to preserve package order
' 2007-07-31, JFW, Per Rick Dingman, warn shipper of previous shipment on this order.
' 2007-07-31, JFW, Per Rick Dingman, change use of address lines.
' 2007-10-23, JFW, Per Rick, no email on service orders.
'
'---------------------------------------------------------------------------------------


' See Project properties for Conditional Compilation
#If Copernicus Then

Option Explicit

Dim m_CNIn As ADODB.Connection
Dim m_CNOut As ADODB.Connection
Dim m_CNAbaci As ADODB.Connection
Dim m_RS As ADODB.Recordset
Dim m_strLine As String
Dim m_boolShipComplete As Boolean


'2/8/05 - API function declaration to add DSN to system used in AddDSN() function.
Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal _
   hwndParent As Long, ByVal fRequest As Long, ByVal _
   lpszDriver As String, ByVal lpszAttributes As String) As Long

'+
' 2006-09-20, JFW, From Copernicus FXI
' Declare object(s)
Public g_strCustNo As String        'Hold Customer Number
'Public g_strPONo As String          'Hold Customer PO Number
Public g_strRefNo As String         'Hold Customer Reference Number
Public g_strCountry As String       'Hold shipto Country
Public g_strZip As String           'Holds zip code
Public g_strEmail As String         'Hold Email address
Public g_strEmail2 As String        'Hold Email address
Public g_blnServiceOrder As Boolean 'Flage for email
'~

   
'---------------------------------------------------------------------------------------
' Procedure : AddDSN
' DateTime  : 2/8/2005
' Purpose   : Adds the FSMSClient v720.3 DSN
' Call from : Form_Load
'---------------------------------------------------------------------------------------
'
Private Function AddDSN() As Boolean
    On Error GoTo EH
    
    Dim ret As Long
    Dim Driver As String
    Dim Attributes As String
    
    If GetSystemName = "WINXPC9CA96EA3" _
    Or GetSystemName = "CAN00335113" Then
        Driver = "Microsoft Access Driver (*.mdb)"
        Attributes = Attributes & "DBQ=C:\Program Files\FedEx\Integration\Projects\Copernicus\Data\Orders.mdb" & Chr(0)
    Else
        Driver = "Microsoft Access Driver (*.mdb)"
        Attributes = Attributes & "DBQ=" & App.Path & "\FSMSClientTest.mdb" & Chr(0)
    End If
    Attributes = Attributes & "DSN=CopernicusFSMS" & Chr(0)
    Attributes = Attributes & "DESCRIPTION=FSMS Client Copernicus ship data" & Chr(0)

    ret = SQLConfigDataSource(0, 4, Driver, Attributes)
   
    If ret <> 1 Then
        AddDSN = False
    Else
        AddDSN = True
    End If

    Exit Function
EH:
    AddDSN = False

End Function
'


' Procedure : AfterAddrVerify()
' DateTime  : 5/12/2006
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             Address Verification. Three possible status codes are passed. See comments
'             below.
'---------------------------------------------------------------------------------------
'
Public Sub AfterAddrVerify(ByVal intStatusCode As Integer)

    Select Case intStatusCode
        'Address is verfified
        Case 1

        'Soft error
        Case 2

        'Hard error
        Case 3

    End Select

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterAddrVerifyUpdate()
' DateTime  : 9/13/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             an address has been updated on the Ship form.
'---------------------------------------------------------------------------------------
'
Public Sub AfterAddrVerifyUpdate()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : AfterBatchShip()
' DateTime  : 10/28/2005
' Purpose   : REQUIRED SUB. Called just after a batch transaction has been processed.
'---------------------------------------------------------------------------------------
'
Public Sub AfterBatchShip()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterBatch()
' DateTime  : 4/6/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             a batch shipment has been completed.
'---------------------------------------------------------------------------------------
'
Public Sub AfterBatch()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : AfterLocationChange()
' DateTime  : 3/06/2006
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             the shipping Location has been changed on the Ship form.
'---------------------------------------------------------------------------------------
'
Public Sub AfterLocationChange()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : AfterLostFocus()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             cboDept or f38 loses focus.
'---------------------------------------------------------------------------------------
'
Public Sub AfterLostFocus(c1 As Control)

    If c1.name = "f38" Then
        'g_clsReg.SetRegistryValue "Carry_f38", frmShip.f38, REG_SZ
    End If
    If c1.name = "f1273" Then
        'g_clsReg.SetRegistryValue "Carry_f1273", Left(frmShip.f1273.Text, 2), REG_SZ
    End If

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : AfterRateQuote()
' DateTime  : 20071106-01
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             a rate quote.
'---------------------------------------------------------------------------------------
'
Public Sub AfterRateQuote()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : BeforeBatch()
' DateTime  : 20070621-01 Changed BeforeBatch to return a boolean
' Purpose   : REQUIRED SUB. Called before an entire batch is processed.
'---------------------------------------------------------------------------------------
'
Public Function BeforeBatch() As Boolean

    BeforeBatch = True

End Function
'


'---------------------------------------------------------------------------------------
' Procedure : BuildCustomSPLabel()
' DateTime  : 20070620-04
' Purpose   : REQUIRED SUB. Can be used as hook to create custom EPL or ZPL buffer labels
'             for SmartPost.
'---------------------------------------------------------------------------------------
'
Public Function BuildCustomSPLabel(ByVal strLabel As String) As String

    BuildCustomSPLabel = strLabel

End Function
'

Public Function ClearCommodity() As Boolean

End Function
'

Public Function ClearShipScreen() As Boolean

    frmShip.f38 = g_clsReg.GetRegistryValue("Carry_f38", "")
    
    g_strRefNo = ""
    
    'debugprintNow
    
End Function

'---------------------------------------------------------------------------------------
' Procedure : GetData()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Called from frmShip.f1_LostFocus, which is the OrderID field.
'             Call routines needed to get data from the customer's system and assign the
'             value to the appropriate fields on the Ship form. This example uses ODBC.
'---------------------------------------------------------------------------------------
'
Public Function GetData(ByVal strKey As String) As Boolean
    On Local Error GoTo Handler
    Dim strSelect As String
    Dim strUserPwd As String    'DSN user and password separated by ','
    Dim strUser As String       'DSN user name
    Dim strPwd As String        'DSN user password
    Dim strData As String
    Dim i As Long
    Dim iMsgBoxResult As VbMsgBoxResult
    Dim colShipped As New Collection
    Dim rsOut As ADODB.Recordset
    
    If g_clsReg.GetRegistryValue("IntegrationLevel", "Writeback") <> "Writeback" _
    And g_clsReg.GetRegistryValue("IntegrationLevel", "Writeback") <> "Order Lookup" Then
        GetData = True
        Exit Function
    End If
        
    If Not Connect Then Exit Function   'set conection and recordset
    
    ' 2007-07-31, JFW, Per Rick Dingman, warn shipper of previous shipment on this order.
    g_strErrorLocation = "Shipped"
    strData = GetDataShipped(strKey)
    If strData <> "" Then
        strData = strData & "Escape/Cancel to quit."
        iMsgBoxResult = MsgBox(strData, vbApplicationModal + vbOKCancel)
        If iMsgBoxResult = vbCancel Then
            frmShip.f1.Text = ""
            frmShip.f1.SetFocus
            Exit Function
        End If
    End If
    strData = ""
        
    If GetSystemName = "WINXPC9CA96EA3" Then
        strSelect = "select * from Sales_order_header"
        strSelect = strSelect & " Where "
        strSelect = strSelect & "sales_order_no = " & strKey & " "
    Else
        strSelect = "SELECT "
        strSelect = strSelect & "sales_order_no, header.bill_to_code, header.sales_order_id, "
        strSelect = strSelect & "header.so_location, header.status, shipto.company_name, shipto.address, shipto.city, shipto.state, "
        strSelect = strSelect & "shipto.postal_code, shipto.country, customer_po_no, "
        strSelect = strSelect & "alternative_ref_no, shipto.contact_first_name, shipto.contact_last_name, "
        strSelect = strSelect & "shipto.ship_to_code, cust.ein_no, email, fax_3, "
        strSelect = strSelect & "body.item, item_description, item.description, order_qty, "
        ' 2008-11-24, JFW, Weight from Item
        strSelect = strSelect & "final_unit_price, item.weight, tariff_code "
        strSelect = strSelect & "FROM sales_order_header as header "
        strSelect = strSelect & "left join sales_order_shipto as shipto "
        strSelect = strSelect & "on header.sales_order_id = shipto.sales_order_id "
        strSelect = strSelect & "left join customer as cust "
        strSelect = strSelect & "on header.ship_to_code = cust.company_code "
        strSelect = strSelect & "left join customer as bill "
        strSelect = strSelect & "on header.bill_to_code = bill.company_code "
        strSelect = strSelect & "left join company_list as colist "
        strSelect = strSelect & "on header.ship_to_code = colist.company_code "
        strSelect = strSelect & "left join sales_order_body as body "
        strSelect = strSelect & "on header.sales_order_id = body.sales_order_id "
        strSelect = strSelect & "left join item as item "
        strSelect = strSelect & "on body.item = item.item "
        strSelect = strSelect & "where "
        strSelect = strSelect & "sales_order_no = " & strKey & " "
    End If
    
    'debugprintstrSelect
    
    m_RS.CursorLocation = adUseClient
    m_RS.Open strSelect, m_CNIn, adOpenStatic     'run SELECT

    ' Set m_RS.ActiveConnection = Nothing
    ' m_CNIn.Close

    If m_RS.BOF And m_RS.EOF Then
        'No records found for that order number
        m_RS.Close
        GetData = False
        Exit Function
    End If
    
'    If m_RS!Status & "" <> "R" Then
'        ' Order not released
'        Set g_frmMsgBox = New frmMsgBox
'        g_frmMsgBox.Message = "Order " & strKey & " is not status ""R"" and may not be shipped at this time."
'        g_frmMsgBox.TimeOut = 4000
'        Set g_frmMsgBox = Nothing
'        m_RS.Close
'        GetData = False
'        Exit Function
'    End If
        
    If m_RS!Status & "" < "O" Then
        ' Order not released
        frmMsgBox.ShowMessage "Order " & strKey & " is not status ""O"" or greater, and may not be shipped at this time.", 4000
        m_RS.Close
        GetData = False
        Exit Function
    End If
    
    i = 0
    Do
        If i = 1 Then Exit Do
        Select Case LCase(Left(InputBox("Is shipping complete? (Y/N) "), 1))
        Case "y", "t", 1
            m_boolShipComplete = True
            i = 1
        Case "n", "f", 0
            m_boolShipComplete = False
            i = 1
        End Select
    Loop
    
    Call DeleteIntlCommodities(strKey)

    strData = ""
    If m_RS.EOF Then
        strData = "No records"
    Else
        For i = 0 To m_RS.Fields.Count - 1
            strData = strData & vbCrLf & m_RS.Fields(i).name & " " & m_RS.Fields(i).Value
        Next i
    End If
    
    strData = "Record count " & m_RS.RecordCount & vbCrLf & strData
    
    Call GetDataToShip

    ' Example use of the SetMessage sub
    ' Call SetMessage("Destination state is: " & m_RS!State, 16, vbBlack, True)

    frmShip.f1670.SetFocus
    
    GetData = True
Release:
    ' call kill
    Exit Function
Handler:
    MsgBox Err.Description, , "modODBC.GetData"
    Call Kill
    Resume Release
    Resume

End Function
'


'---------------------------------------------------------------------------------------
' Procedure : GetDataShipped()
' DateTime  : 7/5/2004
' Purpose   : Copernicus integration.  Test shipping confirmation tables for
'             previous shipments
' 2007-07-31, JFW, Per Rick Dingman, warn shipper of previous shipment on this order.
'---------------------------------------------------------------------------------------
'
Private Function GetDataShipped(ByVal strKey As String) As String
    On Local Error GoTo Handler
    Dim strSelect As String
    Dim strData As String
    Dim i As Long
    Dim iMsgBoxResult As VbMsgBoxResult
    Dim colShipped As New Collection
    Dim rsOut As ADODB.Recordset
    
    strData = ""
        
    If Not Connect Then Exit Function   'set conection and recordset
    
    g_strErrorLocation = "SQL FedEx Write back"
    ' Set SQL statement
    strSelect = "select * from `FedEx Write back` where "
    strSelect = strSelect & "`Invoice #` = "
    strSelect = strSelect & "'" & strKey & "' "
    strSelect = strSelect & "order by [Date shipped], [Tracking #] "
    
    Set rsOut = New ADODB.Recordset
    rsOut.CursorLocation = adUseClient
    rsOut.Open strSelect, m_CNOut, adOpenStatic
    If Not rsOut.EOF Then
        strData = "Order shipped on " & vbCrLf
        Do
            If rsOut.EOF Then Exit Do
            If colShipped.Count = 0 Then
                colShipped.Add rsOut.Fields("Date shipped").Value
                colShipped.Add rsOut.Fields("Tracking #").Value
            ElseIf colShipped.item(colShipped.Count - 1) <> rsOut.Fields("Date shipped").Value Then
                colShipped.Add rsOut.Fields("Date shipped").Value
                colShipped.Add rsOut.Fields("Tracking #").Value
            End If
            rsOut.MoveNext
        Loop
        For i = 1 To colShipped.Count
            strData = strData & colShipped.item(i) & " trk # " & colShipped.item(i + 1) & vbCrLf
            i = i + 1
        Next i
    End If
    rsOut.Close
    
    If IsNumeric(g_strRefNo) Then
        g_strErrorLocation = "SQL shipping_confirm"
        ' Set SQL statement
        strSelect = "select * from shipping_confirm where "
        strSelect = strSelect & "sales_order_no = "
        strSelect = strSelect & "" & strKey & " and shipping_complete = 1 and status <> 'D' "
        strSelect = strSelect & "order by shipping_date, bill_of_lading_no "
        
        Set rsOut = New ADODB.Recordset
        rsOut.CursorLocation = adUseClient
        rsOut.Open strSelect, m_CNAbaci, adOpenStatic
        If Not rsOut.EOF Then
            strData = "Order confirm on " & vbCrLf
            Do
                If rsOut.EOF Then Exit Do
                If colShipped.Count = 0 Then
                    colShipped.Add rsOut.Fields("shipping_date").Value
                    colShipped.Add rsOut.Fields("bill_of_lading_no").Value
                ElseIf colShipped.item(colShipped.Count - 1) <> rsOut.Fields("shipping_date").Value Then
                    colShipped.Add rsOut.Fields("shipping_date").Value
                    colShipped.Add rsOut.Fields("bill_of_lading_no").Value
                End If
                rsOut.MoveNext
            Loop
            For i = 1 To colShipped.Count
                strData = strData & colShipped.item(i) & " trk # " & colShipped.item(i + 1) & vbCrLf
                i = i + 1
            Next i
        End If
        rsOut.Close
    End If
    
    GetDataShipped = strData
    
    
Release:
    ' call kill
    Exit Function
Handler:
    MsgBox Err.Description, , "modODBC.GetDataShipped"
    Call Kill
    Resume Release
    Resume

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : GetData()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Called from frmShip.f1_LostFocus, which is the OrderID field.
'             Call routines needed to get data from the customer's system and assign the
'             value to the appropriate fields on the Ship form. This example uses ODBC.
'---------------------------------------------------------------------------------------
'
Public Sub GetDataToShip()

    On Local Error GoTo Handler

    Dim strZipCode As String
    Dim intZipLen As Integer
    Dim lngWeight As Double
    Dim strHarmCode As String
    Dim strMyHarmCode As String
    Dim strCCofMan  As String
    Dim strTaxID As String
    
'    ' Declare variables for procedure
'    Dim i As Long
'    Dim blnADDComm As Boolean
'    Dim strCommCode As String
'    Dim strSQLComm As String
'    Dim strMeter As String
        
    With frmShip
        
        g_strErrorLocation = "Zip"
        g_strZip = Trim(CStr(m_RS!postal_code & ""))
        ' 2008-03-31, JFW, Abaci zip received with decimal places
        If IsNumeric(g_strZip) Then
            g_strZip = CDbl(g_strZip)
        End If
        g_strZip = Replace(g_strZip, "-", "")
        g_strZip = Replace(g_strZip, " ", "")
        
        g_strErrorLocation = "Country"
        g_strCountry = Trim(CStr(m_RS!Country & ""))
        
        ' 2008-04-21, JFW, US drop ship to CA has US country
        If g_strCountry = "US" And Not IsNumeric(g_strZip) Then
            g_strCountry = "CA"
        End If
        
        If Len(g_strCountry) <> 2 Then
            If IsNumeric(g_strZip) Then
                If Len(g_strZip) <= 5 Then
                    g_strCountry = "US"
                    g_strZip = Right("00000" & g_strZip, 5)
                End If
            Else
                g_strCountry = "CA"
            End If
        Else
            g_strCountry = CountryConv(g_strCountry)
        End If
        
        g_strErrorLocation = "AccountSwitch"
        If True Or False Then
        If GetSystemName <> "WINXPC9CA96EA3" _
        And GetSystemName <> "CAN00335113" Then
            If g_strCountry = "US" Then
                If Not SetCurrentAccount("224037961") Then
                    MsgBox "Unable to switch to US account 224037961.  Please select account from Location box", vbExclamation, "Error"
                End If
            Else
                If Not SetCurrentAccount("221737920") Then
                    MsgBox "Unable to switch to account 221737920.  Please select account from Location box", vbExclamation, "Error"
                End If
            End If
        End If
        End If
        
        g_strErrorLocation = "?"
        If g_strCountry <> "CA" And g_strCountry <> "GB" Then
            g_strZip = ZipConv(g_strCountry, g_strZip)
        End If
        
        .f12.Text = Trim(CStr(m_RS!contact_first_name & "")) & " " & Trim(CStr(m_RS!contact_last_name & ""))
        .f11.Text = Trim(CStr(m_RS!company_name & ""))
        ' Incoming 4 lines of address
        .f13.Text = Trim(CStr(m_RS!address & ""))
        
        .f15.Text = Trim(CStr(m_RS!City & ""))
        .f16.Text = Trim(CStr(m_RS!State & ""))
        .f17.Text = g_strZip
        .f18.Text = "5198483664"
        .f50.Text = g_strCountry
        
        .f1358.Text = m_RS!ein_no & ""
        .f1358.Text = Replace(.f1358.Text, " ", "")
        .f1358.Text = Replace(.f1358.Text, "-", "")
        .f1358.Text = Replace(.f1358.Text, "#", "")
        
        ' 2008-04-29, JFW, per Rick.
        'g_strPONo = Trim(CStr(m_RS!customer_po_no & ""))
        'g_strPONo = Trim(CStr(m_RS!alternative_ref_no & ""))
        g_strRefNo = Trim(CStr(m_RS!sales_order_no & ""))
               
        g_strErrorLocation = "Email"
        ' 2007-10-23, JFW, Per Rick, no email on service orders.
        'If UCase(Left(g_strPONo, 1)) <> "S" _
        'And UCase(Left(g_strRefNo, 1)) <> "S" Then
        If LCase(Trim(CStr(m_RS!so_location & ""))) = "arthur" Then
            ' 2006-10-26, JFW, Email in field 1 or 2, 1 - recip, 2 - other (Express only)
            '        g_strEmail = Trim(CStr(m_RS!EMAIL1 & ""))
            '        g_strEmail2 = Trim(CStr(m_RS!EMAIL2 & ""))
            ' 2006-10-26, JFW, Use only email2 for recipient
            ' 2006-10-27, JFW, Back to email 1
            g_strEmail = Trim(CStr(m_RS!email & ""))
            g_strEmail2 = ""
            If g_strEmail <> "" Or g_strEmail2 <> "" Then
                frmShip.chkEmailAlert.Value = 1
                DoEvents
            End If
            If g_strEmail <> "" Then
                frmEmail.f1202.Text = g_strEmail ' Recipient email
                frmEmail.f1203.Text = "Customer PO number " & Trim(CStr(m_RS!customer_po_no & ""))
                frmEmail.f1557.Value = 1 ' .SpecialServices.ShipAlert.Recipient.ShipmentNotification = True
                ' .SpecialServices.ShipAlert.Recipient.GroundMemo = "Invoice #:" & g_strRefNo & " / P.O. #:" & g_strPONo
            End If
            If g_strEmail2 <> "" Then
                frmEmail.f1203.Text = "Customer PO number " & Trim(CStr(m_RS!customer_po_no & ""))
                frmEmail.f1204(1).Text = g_strEmail2 ' .SpecialServices.ShipAlert.Other1.Email = g_strEmail2
                frmEmail.f1206(1).Value = 1 ' .SpecialServices.ShipAlert.Other1.ShipmentNotification = True
                ' .SpecialServices.ShipAlert.Other1.GroundMemo = "Invoice #:" & g_strRefNo & " / P.O. #:" & g_strPONo
            End If
            If g_strEmail <> "" Or g_strEmail2 <> "" Then
                Call frmEmail.Save
                DoEvents
            End If
        End If
        
        g_strErrorLocation = "Piece"
        .f116.Text = 1 ' .Count = 1
        
        g_strErrorLocation = "?"
        
        .f23.Text = 1
        .f1273.Text = "01"
        .f75.Text = "LBS"
        ' 2008-04-29, JFW, per Rick, alternative_ref_no and customer_po_no.
        '.f25.Text = Trim(CStr(m_RS!customer_po_no & ""))
        '.f3056.Text = Trim(CStr(m_RS!alternative_ref_no & ""))
        ' 2008-06-10, JFW, per Rick
        .f25.Text = Trim(CStr(m_RS!alternative_ref_no & ""))
        .f3056.Text = Trim(CStr(m_RS!customer_po_no & ""))
        .f3057.Text = g_strRefNo & ", " & Trim(CStr(m_RS!alternative_ref_no & ""))
        g_str581 = Trim(CStr(m_RS!alternative_ref_no & ""))
        g_str582 = g_strRefNo
        
        g_strErrorLocation = "Service"
        .f1274.Text = 92
        
        g_strErrorLocation = "Curr"
        
        g_strErrorLocation = "TD"
        If g_strCountry <> "CA" Then
            .f1090.Text = "USD"
            If g_strCountry = "US" Then
                .f1482.Value = 1
            End If
            .f72.Text = "1"
        Else
            .f1090.Text = "CAD"
        End If
                
        lngWeight = 0
        
        g_strErrorLocation = "Commodities"
        
        Do While Not m_RS.EOF
            
            If m_RS!item_description & "" <> "" _
            Or m_RS!Description & "" <> "" Then

            g_strErrorLocation = "HarmCode"
            ' Setting Harmonized code
            strHarmCode = Trim(m_RS!tariff_code & "")
            strHarmCode = PhoneTrim(strHarmCode)
            If strHarmCode <> "" Then
                strHarmCode = strHarmCode & "0000000000"
                strMyHarmCode = Left(strHarmCode, 10)
                strHarmCode = strMyHarmCode
                'strHarmCode = Left(strMyHarmCode, 4) & "."
                'strHarmCode = strHarmCode & Mid(strMyHarmCode, 5, 2) & "."
                'strHarmCode = strHarmCode & Right(strMyHarmCode, 4)
            End If
            
            g_strErrorLocation = "OptField"
            If Len(strCCofMan) <> 2 Then
               strCCofMan = "CA"
            End If
            
            g_strErrorLocation = "CommodityInsert"
            Call InsertIntlCommodities(Trim(CStr(m_RS!sales_order_no & "")), _
                "0", _
                 IIf(m_RS!item_description & "" <> "", QuoteTrim(m_RS!item_description) & "", QuoteTrim(m_RS!Description) & ""), _
                 strCCofMan, _
                strHarmCode, _
                IIf(IsNumeric(Trim(m_RS!order_qty & "")), IIf(Val(Trim(m_RS!order_qty & "")) > 0, Trim(m_RS!order_qty & ""), "1"), "1"), _
                "", _
                "", _
                "EA" & "", _
                IIf(IsNumeric(m_RS!final_unit_price & ""), IIf(Val(m_RS!final_unit_price & "") > 0, Trim(m_RS!final_unit_price & ""), "1"), "1"), _
                IIf(IsNumeric(Trim(m_RS!order_qty & "")) _
                        And IsNumeric(m_RS!final_unit_price & ""), _
                    CStr(Val(m_RS!final_unit_price & "") _
                        * Val(Trim(m_RS!order_qty & ""))), _
                    "1"), _
                m_RS!item _
                )
            
            g_strErrorLocation = "CommWeight"
            ' Accumulate weight of shipment
            lngWeight = lngWeight + Val(m_RS!Weight & "")
            If lngWeight = 0 Then lngWeight = 1
            
            End If
            
            g_strErrorLocation = "CommNext"
            m_RS.MoveNext
        Loop
        
        ' If no commodities in query, then service shipment.
        If lngWeight = 0 Then
            Call InsertIntlCommodities(.f25.Text, _
                "0", _
                "Replacement parts", _
                "CA", _
                "", _
                "1", _
                "", _
                "", _
                "EA" & "", _
                ".000001", _
                ".000001", _
                "" _
                )
        End If
                
        g_strErrorLocation = "1670"
        .f1670.Text = lngWeight
        
        If CDbl(.f1670.Text) <= 0 Then
            .f1670.Text = 1
        End If
        
        .f1670.SetFocus 'Set focus to read scale
    End With

    g_strErrorLocation = "Done"
Release:
    ' call kill
    Exit Sub
Handler:
    MsgBox "Error at " & g_strErrorLocation & " - " & Err.Description, , "modODBC.GetDataToShip"
    Call Kill
    Resume Release
    Resume

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : GetPickupData()
' DateTime  : 1/30/2006
' Purpose   : REQUIRED SUB. Called from frmAddTags.f1_LostFocus, which is the OrderID field.
'             Call routines needed to get data from the customer's system and assign the
'             value to the appropriate fields on the Ship form. This example uses ODBC.
'---------------------------------------------------------------------------------------
'
Public Function GetPickupData(ByVal strKey As String) As Boolean


    GetPickupData = True

End Function
'


'---------------------------------------------------------------------------------------
' Procedure : WriteBatchEditReply()
' DateTime  : 1/17/2006
' Purpose   : REQUIRED SUB. Called after a successful Batch Error Edit transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteBatchEditReply()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : WriteBOLReply()
' DateTime  : 1/11/2006
' Purpose   : REQUIRED SUB. Called after a successful FedEx Freight BOL transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteBOLReply()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : WriteCancelTagReply()
' DateTime  : 1/26/2006
' Purpose   : REQUIRED SUB. Called after a successful Cancel Call Tag/Express Tag transaction.
'---------------------------------------------------------------------------------------
'
Public Sub WriteCancelTagReply()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : WriteReply()
' DateTime  : 2/14/2005
' Purpose   : REQUIRED SUB. Called after a successful ship transaction.
'             This example shows how to obtain multiple occurrence fields from the
'             FXRS reply and how to obtain multiple occurrence fields included in the
'             input transaction but not returned in the FXRS reply.
'---------------------------------------------------------------------------------------
'
Public Sub WriteReply()
    
    On Local Error GoTo Handler
    
    ' Declare variables for procedure
    Dim strSQL As String
    
    Dim i As Integer
    Dim j As Integer
    
    Dim f1 As String                    'OrderID (in TransID field)
    Dim f35 As String                   'Total surcharges
    Dim f37 As String                   'Net charge
    Dim f60 As String                   'Billed weight
    Dim f116 As String                  'Num pkgs
    Dim strInsert As String             'SQL INSERT
    Dim strMPS As String                'MPS SELECT query
    Dim rsMPS As New ADODB.Recordset    'Used to capture MPS input fields
    
    'Declare string arrays for trk#s and declared values
    Dim str29() As String
    Dim str26() As String
    
    Dim intNumPkgs As Integer

    If g_clsReg.GetRegistryValue("IntegrationLevel", "Writeback") <> "Writeback" Then
        Exit Sub
    End If

    ' 2006-11-07, JFW, Copernicus writeback table requires invoice number field.
    If g_strRefNo = "" Then
        Exit Sub
    End If
    
    g_strErrorLocation = "Connect"
    
    ' Validate Connection object
    If Not Connect Then Exit Sub

    'Get # of pkgs
    g_strErrorLocation = "116"
    intNumPkgs = Val(g_str116)
    
    'ReDim the string array using the # of pkgs
    ReDim str29(intNumPkgs)
    ReDim str26(intNumPkgs)
    
    'Get the fields you wish from the reply transaction
    g_strErrorLocation = "Parser"
    With frmShip.g_clsParser
        For i = 0 To .TotalFields - 1
            Select Case .Field(i)
                Case "1"
                    f1 = .Data(i)           'TransID
                Case "29"
                    str29(1) = .Data(i)     'First trk#
                Case "35"
                    f35 = .Data(i)          'Total Surcharges
                Case "37"
                    f37 = .Data(i)          'Net Charges
                Case "60"
                    f60 = .Data(i)          'Billed Weight
                Case "116"
                    f116 = .Data(i)         '# Pkgs
            End Select
            
            'Get multiple occurrence tracking #s
            'Note: This will capture Int'l MPS child trk#s as well as domestic MPS
            If intNumPkgs > 1 And frmShip.chkDuplicate = 0 Then
                For j = 2 To intNumPkgs
                    If .Field(i) = "29-" & Trim(Str(j)) Then str29(j) = .Data(i)
                Next
            End If
        Next
    End With
    
    g_strErrorLocation = "MPS"
    'Query to get fields saved in MPS table for MPS transactions
    ' 2006-11-07, JFW, Add order to MPS select to preserve package order
    strMPS = "SELECT * FROM MPS WHERE f1 = '" & f1 & "' order by ShipDate"
    'Open recordset
    rsMPS.Open strMPS, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic
    
    'Loop through the MPS recordset and assign the Declared Value fields
    'Note: You can also capture any other MPS field using this loop by declaring
    'variables for those data element assigning the values here.
    g_strErrorLocation = "DV"
    i = 1
    If Not rsMPS.EOF Then
        Do Until rsMPS.EOF
            str26(i) = rsMPS!g_str26 & ""
            rsMPS.MoveNext
            i = i + 1
        Loop
    Else
        str26(1) = g_str26
    End If
    
    'Perform Insert query for each package
    g_strErrorLocation = "NumPkgs"
    For i = 1 To intNumPkgs
        If str29(i) <> "" Then

            If Not IsNumeric(g_str1670) Then
                g_str1670 = 1
            End If
            
            g_strErrorLocation = "SQL insert"
            ' Set SQL statement
            strSQL = "Insert Into  `FedEx Write back` ("
            strSQL = strSQL & "`Tracking #`,"
            strSQL = strSQL & "`Invoice #`,"
            strSQL = strSQL & "`Customer Po #`,"
            strSQL = strSQL & "`Net rate`,"
            strSQL = strSQL & "`Date shipped`,"
            strSQL = strSQL & "`Weight`,"
            strSQL = strSQL & "`Ship adress 1`,"
            strSQL = strSQL & "`Ship adress 2`,"
            strSQL = strSQL & "`Zip`,"
            strSQL = strSQL & "`Country`,"
            strSQL = strSQL & "`Company`,"
            strSQL = strSQL & "`Est delivery date`)"
            strSQL = strSQL & " Values ("
            strSQL = strSQL & "'" & str29(i) & "',"
            strSQL = strSQL & "'" & g_str1 & "',"
            If 0 <> InStr(1, g_str3057, "Pkg ") Then
                g_str3057 = Left(g_str3057, InStr(1, g_str3057, "Pkg "))
                If Right(g_str3057, 2) = ", " Then
                    g_str3057 = Left(g_str3057, Len(g_str3057) - 2)
                End If
            End If
            ' 2008-05-21, JFW, Per Rick email 05/14, rather that field 3056.
            strSQL = strSQL & "'" & g_str25 & "',"
            strSQL = strSQL & "'" & g_str37 & "',"
            strSQL = strSQL & "'" & g_str24 & "',"
            strSQL = strSQL & "'" & g_str1670 & "',"
            strSQL = strSQL & "'" & g_str13 & "',"
            strSQL = strSQL & "'" & g_str14 & "',"
            strSQL = strSQL & "'" & g_str17 & "',"
            strSQL = strSQL & "'" & g_str50 & "',"
            strSQL = strSQL & "'" & g_str11 & "',"
            strSQL = strSQL & "'" & g_str409 & "')"
    
            m_CNOut.Execute strSQL
            
        End If ' str29
        
    Next i
    
    'Perform Insert query for each package
    g_strErrorLocation = "NumPkgs"
    For i = 1 To intNumPkgs
        If str29(i) <> "" _
        And IsNumeric(g_strRefNo) Then

            If Not IsNumeric(g_str1670) Then
                g_str1670 = 1
            End If
            
            g_strErrorLocation = "SQL insert"
            ' Set SQL statement
            strSQL = "Insert Into shipping_confirm ("
            strSQL = strSQL & "bill_of_lading_no,"
            strSQL = strSQL & "sales_order_no,"
            strSQL = strSQL & "shipping_date,"
            strSQL = strSQL & "shipping_complete,"
            strSQL = strSQL & "status,"
            strSQL = strSQL & "carrier_code)"
            
            strSQL = strSQL & " Values ("
            strSQL = strSQL & "'" & str29(i) & "',"
            strSQL = strSQL & "" & g_strRefNo & ","
            strSQL = strSQL & "'" & IIf(IsDate(g_str24), Format(CDate(g_str24), "yyyy-mm-dd"), IIf(IsNumeric(g_str24) And Len(g_str24) = 8, Format(g_str24, "0000-00-00"), Format(Date, "yyyy-mm-dd"))) & "',"
            strSQL = strSQL & "" & IIf(m_boolShipComplete, 1, 0) & ","
            strSQL = strSQL & "'" & "" & "',"
            strSQL = strSQL & "'" & "FedEx" & "')"
    
            m_CNAbaci.Execute strSQL
            
        End If ' str29
        
    Next i
    
    g_strRefNo = ""
    g_strErrorLocation = "Done"
    
Release:
    ' call kill
    If rsMPS.State = adStateOpen Then rsMPS.Close
    Set rsMPS = Nothing
    Exit Sub

Handler:
    MsgBox "Error at " & g_strErrorLocation & " - " & Err.Description, , "modODBC.WriteReply"
    Call Kill
    Resume Release
    
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteError()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             an FXRS Error reply transaction.
'---------------------------------------------------------------------------------------
'
Public Sub WriteError()
    MsgBox "Shipping Error: " & g_str3, vbCritical, "FSMS Error"
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteDelete()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             successful FXRS Delete.
'---------------------------------------------------------------------------------------
'
Public Sub WriteDelete(ByVal strTracking As String)
'Called:    frmShip Parsecomplete event on FSMS 123 reply
'Purpose:   update customer table on void
    On Local Error GoTo Handler
    
    ' Declare variables for procedure
    Dim strSQL As String
    Dim lngErr As Long

    If g_clsReg.GetRegistryValue("IntegrationLevel", "Writeback") <> "Writeback" Then
        Exit Sub
    End If

    ' Validate Connection state
    If Not Connect Then Exit Sub

    ' Validate * is compliant with inline error handling
    On Error Resume Next

    ' Set SQL statement
    strSQL = "Delete From `FedEx Write back`"
    strSQL = strSQL & " Where `Tracking #` = '" & strTracking & "'"

    ' Execute SQL statement
    m_CNOut.Execute strSQL

    ' Try again if necessary
    lngErr = Err.number
    Err.Clear

    If lngErr <> 0 Then
        strSQL = "Delete From `FedEx Write back`"
        strSQL = strSQL & " Where `Tracking #` = '" & strTracking & "'"

        'Execute SQL statement
        m_CNOut.Execute strSQL
    End If
    
    
    ' Set SQL statement
    strSQL = "delete From shipping_confirm"
    strSQL = strSQL & " where bill_of_lading_no = '" & strTracking & "'"

    ' Execute SQL statement
    m_CNAbaci.Execute strSQL

    ' Try again if necessary
    lngErr = Err.number
    Err.Clear

    If lngErr <> 0 Then
        strSQL = "delete From shipping_confirm"
        strSQL = strSQL & " where bill_of_lading_no = '" & strTracking & "'"

        'Execute SQL statement
        m_CNAbaci.Execute strSQL
    End If
    
    
Release:
   ' call kill
   Exit Sub
Handler:
    MsgBox Err.Description, , "modODBC.WriteDelete"
    Call Kill
    Resume Release
    
End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : WriteReturnDelete()
' DateTime  : 7/14/2005
' Purpose   : REQUIRED SUB. Called after a successful return label delete transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteReturnDelete(ByVal strTracking As String)

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : WriteReturnReply()
' DateTime  : 7/14/2005
' Purpose   : REQUIRED SUB. Called after a successful return label transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteReturnReply()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : WriteTagReply()
' DateTime  : 1/26/2006
' Purpose   : REQUIRED SUB. Called after a successful Call Tag/Express Tag transaction.
'---------------------------------------------------------------------------------------
'
Public Sub WriteTagReply()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : Connect()
' DateTime  : 7/5/2004
' Purpose   : Open connection to ODBC test DSN. Instantiate module level recordset.
'---------------------------------------------------------------------------------------
'
Private Function Connect() As Boolean
    On Local Error GoTo Handler
    Dim strDSN As String
    Dim boolSecondTry As Boolean
    
    If m_CNIn Is Nothing Then
        Set m_CNIn = New ADODB.Connection
    End If
    
    If m_CNIn.State <> adStateOpen Then   'if connection is not open then do so
        If GetSystemName = "WINXPC9CA96EA3" _
        Or GetSystemName = "CAN00335113" Then
            m_CNIn.Open "DSN=CopernicusFSMS"
        Else
            m_CNIn.Open "DSN=Abaci;UID=dbc;PWD=sql"
        End If
    End If
    
    If m_CNOut Is Nothing Then
        Set m_CNOut = New ADODB.Connection
    End If
    If m_CNOut.State <> adStateOpen Then   'if connection is not open then do so
        If GetSystemName = "WINXPC9CA96EA3" _
        Or GetSystemName = "CAN00335113" Then
            m_CNOut.Open "DSN=CopernicusOut"
        Else
            m_CNOut.Open "DSN=CopernicusOut"
        End If
    End If
    
    If m_CNAbaci Is Nothing Then
        Set m_CNAbaci = New ADODB.Connection
    End If
    If m_CNAbaci.State <> adStateOpen Then   'if connection is not open then do so
        If GetSystemName = "WINXPC9CA96EA3" _
        Or GetSystemName = "CAN00335113" Then
            m_CNAbaci.Open "DSN=CopernicusOut"
        Else
            m_CNAbaci.Open "DSN=Abaci;uid=fedex;pwd=fdx123;eng=ABACI;commlinks=tcpip"
        End If
    End If
    
    Set m_RS = New ADODB.Recordset
    
    Connect = True
    
    Exit Function

Handler:
    If Not boolSecondTry Then
        boolSecondTry = True
        If Err.number = -2147467259 Then
            Call AddDSN
            Resume
        End If
    End If
    MsgBox Err.Description, , "modODBC.Connect"
    Call Kill        'kill connection and recordset

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : Kill()
' DateTime  : 7/5/2004
' Purpose   : Close connection and recordset objects and set = to nothing.
'---------------------------------------------------------------------------------------
'
Public Sub Kill()
    On Local Error GoTo Handler
    
    If Not m_RS Is Nothing Then
        If m_RS.State = adStateOpen Then m_RS.Close
    End If
    Set m_RS = Nothing      'kill recordset
    
    If Not m_CNIn Is Nothing Then
        If m_CNIn.State = adStateOpen Then m_CNIn.Close
    End If
    Set m_CNIn = Nothing      'kill connection
    
    If Not m_CNOut Is Nothing Then
        If m_CNOut.State = adStateOpen Then m_CNOut.Close
    End If
    Set m_CNOut = Nothing      'kill connection
    
    If Not m_CNAbaci Is Nothing Then
        If m_CNAbaci.State = adStateOpen Then m_CNAbaci.Close
    End If
    Set m_CNAbaci = Nothing      'kill connection
    
    Exit Sub
Handler:
    MsgBox Err.Description, , "modODBC.Kill"

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterClose()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             FXRS Close.
'---------------------------------------------------------------------------------------
'
Public Sub AfterClose()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : BeforeClose()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed before
'             FXRS Close.
'---------------------------------------------------------------------------------------
'
Public Function BeforeClose() As Boolean

    BeforeClose = True

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : BeforeShip()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED Function. Modified to Return Boolean which controls whether or not
'             the shipment will continue or be canceled. Return True to continue shipment,
'             False to cancel.
'---------------------------------------------------------------------------------------
'
Public Function BeforeShip() As Boolean
        
    BeforeShip = True
    
    If Left(frmShip.f50, 2) = "US" Then
        If frmShip.f1358 = "" Then
            MsgBox "Shipments to the U.S. require an IRS/EIN number.", vbExclamation, "Error"
            BeforeShip = False
            frmShip.SSTab1.TabIndex = 1
            frmShip.f1358.SetFocus
        End If
    End If
    
End Function
'


'---------------------------------------------------------------------------------------
' Procedure : BeforeShipTrans()
' DateTime  : 8/7/2008
' Purpose   : REQUIRED Function. Modified to Return Boolean which controls whether or not
'             the shipment will continue or be canceled. Return True to continue shipment,
'             False to cancel.
'---------------------------------------------------------------------------------------
'
Public Function BeforeShipTrans(ByRef TransString As String) As Boolean
    
    Dim lngMsgBoxResult As VbMsgBoxResult
    BeforeShipTrans = True
    
    If TransString <> "" Then
        ' Copernicus custom doc tab
        TransactionStripTag TransString, "583"
        TransactionBuilder TransString, "583", g_str1670
        TransString = Replace(TransString, "99,""""", "")
        TransactionBuilder TransString, 99, ""
    End If
        
    ' Ship trans
    If 0 <> InStr(1, TransString, "0,""020""") Then
    ' Create TD master
    If 0 <> InStr(1, TransString, "TD MAWB CREATE") Then
    ' CCI
    If 0 = InStr(1, TransString, "113,""Y""") Then
        lngMsgBoxResult = MsgBox("You are creating a TD master shipment without commercial data -- no CCI.  Is that OK?", vbYesNo + vbDefaultButton2)
        If lngMsgBoxResult <> vbYes Then
            BeforeShipTrans = False
        End If
    End If
    End If
    End If
    
End Function
'


'---------------------------------------------------------------------------------------
' Procedure : Initialize()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed on
'             program execution.
'---------------------------------------------------------------------------------------
'
Public Sub Initialize(Optional f1 As Form)

    If Not f1 Is Nothing Then
        If f1.name = "frmShip" Then
            frmShip.f38 = g_clsReg.GetRegistryValue("Carry_f38", "")
        End If
    End If
    
End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : BeforeBatchShip()
' DateTime  : 8/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed on
'             program execution. Called just before a batch transaction is sent to the server.
'---------------------------------------------------------------------------------------
'
Public Function BeforeBatchShip() As Boolean

    BeforeBatchShip = True
    
End Function
'

'---------------------------------------------------------------------------------------
' Procedure : AfterAddrLookup()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             cboCustID, cboContact, or cboCompany loses focus.
'---------------------------------------------------------------------------------------
'
Public Sub AfterAddrLookup()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterDeptLostFocus()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             cboDept or f38 loses focus.
'---------------------------------------------------------------------------------------
'
Public Sub AfterDeptLostFocus()

    g_clsReg.SetRegistryValue "Carry_f38", frmShip.f38, REG_SZ
    
End Sub
'

#End If
